perm filename FILLNX.F4[XX,LCS] blob
sn#231803 filedate 1976-08-15 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE FILLER(QQ,MD)
C00005 ENDMK
Cā;
SUBROUTINE FILLER(QQ,MD)
COMMON /FLM/I(600) /ALF/NO,H(72) /PLTR/P,RHT,DIS
DIMENSION Q(1)
C H(72) =NO MORE THAN 72 SEGS AT ANY SLICE POSITION!!!
EQUIVALENCE (Q,I)
KNT=I(3)
RL=Q(1)
RR=RL
DO 1 K=1,KNT,3
CC Q(K)=IFIX(Q(K))
CC Q(K+1)=IFIX(Q(K+1))
IF(I(K+2).EQ.3)I(K+2)=-1
A=Q(K)
IF(Q(K+3).EQ.A)I(K+5)=-1
C VERTICAL LINES WILL BE IGNORED.
IF(RL.GT.A)RL=A
1 IF(RR.LT.A)RR=A
C GET LEFT AND RIGHT EXTREME LIMITS.
RR=RR-.5
RL=RL-.5
2 RL=RL+1
C SLICE COUNTER
IF(RL.GT.RR)RETURN
M=0
DO 3 J=4,KNT,3
IF(I(J+2))GO TO 3
IF(IHORZ(I,J,RL))GO TO 3
C FINDS SEGS UNDER SLICE AND REJECTS VERTICALS.
M=M+1
H(M)=HGT(J,RL,I)
3 CONTINUE
IF(M.EQ.0)GO TO 2
C M=0=SPACE BETWEEN OBJECTS -- NO FILLER
J=1
5 IF(H(J).GE.H(J+1))GO TO 4
C SORTS HEIGHTS
CALL EXCH(H(J),H(J+1))
IF(J.EQ.1)GO TO 4
J=J-1
GO TO 5
4 J=J+1
IF(J.LT.M)GO TO 5
C GO BACK IF MORE SORTING TO BE DONE
NN=1
6 IF(H(NN).EQ.H(NN+1))GO TO 7
A=H(NN)
B=H(NN+1)
IF(A-B.GT.1)CALL LINX(RL,A-1.,RL,B+1.)
7 NN=NN+2
C SKIP BY 2'S
IF(NN.LT.M)GO TO 6
GO TO 2
END
FUNCTION HGT(J,RL,Q)
DIMENSION Q(1)
HGT=Q(J-2)
C PREVIOUS Y COORD.
A=Q(J-3)
C PREVIOUS X COORD.
HGT=((Q(J+1)-HGT)*(RL-A))/(Q(J)-A)+HGT
CAN HAVE A DIVIDE BY ZERO HERE!!
END
FUNCTION IHORZ(Q,J,RL)
C L=VERT. SLICE
DIMENSION Q(1)
IHORZ=-1
A=Q(J)
B=Q(J-3)
C PREVIOUS X COORD.
IF(A.GT.B)CALL EXCH(A,B)
IF(RL.LE.B.AND.RL.GE.A)IHORZ=0
END